home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 1.iso
/
ARGONET
/
PD
/
MATHS
/
RLAB
/
RLAB125.ZIP
/
!RLaB
/
misc
/
rlab-mode.
< prev
next >
Wrap
Lisp/Scheme
|
1994-06-03
|
18KB
|
632 lines
;; rlab-mode.el - A major-mode for editing rlab scripts
;; Shamelessly stolen from tcl-mode.el
;;
;; Original
;; Author: Gregor Schmid <schmid@fb3-s7.math.tu-berlin.de>
;; Keywords: languages, processes, tools
;;
;; Subsequent
;; Hacked by: Ian Searle
;;
;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
;; Version 1.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; Please send improvments, bug-fixes, suggestions etc. to
;;
;; ians@eskimo.com
;;
;; This file was written with emacs using Jamie Lokier's folding mode
;; That's what the funny ;;{{{ marks are there for
;;{{{ Usage
;;; Commentary:
;; RLaB-mode supports c-mode style formatting and sending of
;; lines/regions/files to a rlab interpreter. An interpreter (see
;; variable `rlab-default-application') will be started if you try to
;; send some code and none is running. You can use the process-buffer
;; (named after the application you chose) as if it were an
;; interactive shell. See the documentation for `comint.el' for
;; details.
;; Another version of this package which has support for other Emacs
;; versions is in the LCD archive.
;;}}}
;;{{{ Key-bindings
;; To see all the keybindings for folding mode, look at `rlab-setup-keymap'
;; or start `rlab-mode' and type `\C-h m'.
;; The keybindings may seem strange, since I prefer to use them with
;; rlab-prefix-key set to nil, but since those keybindings are already used
;; the default for `rlab-prefix-key' is `\C-c', which is the conventional
;; prefix for major-mode commands.
;; You can customise the keybindings either by setting `rlab-prefix-key'
;; or by putting the following in your .emacs
;; (setq rlab-mode-map (make-sparse-keymap))
;; and
;; (define-key rlab-mode-map <your-key> <function>)
;; for all the functions you need.
;;}}}
;;{{{ Variables
;; You may want to customize the following variables:
;; rlab-indent-level
;; rlab-always-show
;; rlab-mode-map
;; rlab-prefix-key
;; rlab-mode-hook
;; rlab-default-application
;; rlab-default-command-switches
;;}}}
;;; Code:
;; We need that !
(require 'comint)
;;{{{ variables
(defvar rlab-default-application "rlab"
"Default rlab application to run in rlab subprocess.")
(defvar rlab-default-command-switches nil
"Command switches for `rlab-default-application'.
Should be a list of strings.")
(defvar rlab-process nil
"The active rlab subprocess corresponding to current buffer.")
(defvar rlab-process-buffer nil
"Buffer used for communication with rlab subprocess for current buffer.")
(defvar rlab-always-show t
"*Non-nil means display rlab-process-buffer after sending a command.")
(defvar rlab-mode-map nil
"Keymap used with rlab mode.")
(defvar rlab-prefix-key "\C-c"
"Prefix for all rlab-mode commands.")
(defvar rlab-mode-hook nil
"Hooks called when rlab mode fires up.")
(defvar rlab-region-start (make-marker)
"Start of special region for rlab communication.")
(defvar rlab-region-end (make-marker)
"End of special region for rlab communication.")
(defvar rlab-indent-level 2
"Amount by which rlab subexpressions are indented.")
(defvar rlab-default-eval ""
"Default command used when sending regions.")
(defvar rlab-mode-menu (make-sparse-keymap "RLaB-Mode")
"Keymap for rlab-mode's menu.")
;;}}}
;;{{{ rlab-mode
;;;###autoload
(defun rlab-mode ()
"Major mode for editing rlab scripts.
The following keys are bound:
\\{rlab-mode-map}
"
(interactive)
(let ((switches nil)
s)
(kill-all-local-variables)
(setq major-mode 'rlab-mode)
(setq mode-name "RLaB")
(set (make-local-variable 'rlab-process) nil)
(set (make-local-variable 'rlab-process-buffer) nil)
(make-local-variable 'rlab-default-command-switches)
(set (make-local-variable 'indent-line-function) 'rlab-indent-line)
(set (make-local-variable 'comment-start) "#")
(set (make-local-variable 'comment-start-skip) "\\(\\(^\\|;\\)[ \t]*\\)#")
(make-local-variable 'rlab-default-eval)
(or rlab-mode-map
(rlab-setup-keymap))
(use-local-map rlab-mode-map)
(modify-syntax-entry ?# "<")
(modify-syntax-entry ?\n ">")
;; look for a #!.../wish -f line at bob
(save-excursion
(goto-char (point-min))
(if (looking-at "#![ \t]*\\([^ \t]*\\)[ \t]\\(.*[ \t]\\)*-f")
(progn
(set (make-local-variable 'rlab-default-application)
(buffer-substring (match-beginning 1)
(match-end 1)))
(if (match-beginning 2)
(progn
(goto-char (match-beginning 2))
(set (make-local-variable 'rlab-default-command-switches) nil)
(while (< (point) (match-end 2))
(setq s (read (current-buffer)))
(if (<= (point) (match-end 2))
(setq rlab-default-command-switches
(append rlab-default-command-switches
(list (prin1-to-string s)))))))))
;; if this fails, look for the #!/bin/csh ... exec hack
(while (eq (following-char) ?#)
(forward-line 1))
(or (bobp)
(forward-char -1))
(if (eq (preceding-char) ?\\)
(progn
(forward-char 1)
(if (looking-at "exec[ \t]+\\([^ \t]*\\)[ \t]\\(.*[ \t]\\)*-f")
(progn
(set (make-local-variable 'rlab-default-application)
(buffer-substring (match-beginning 1)
(match-end 1)))
(if (match-beginning 2)
(progn
(goto-char (match-beginning 2))
(set (make-local-variable
'rlab-default-command-switches)
nil)
(while (< (point) (match-end 2))
(setq s (read (current-buffer)))
(if (<= (point) (match-end 2))
(setq rlab-default-command-switches
(append rlab-default-command-switches
(list (prin1-to-string s)))))))))
)))))
(run-hooks 'rlab-mode-hook)))
;;}}}
;;{{{ rlab-setup-keymap
(defun rlab-setup-keymap ()
"Set up keymap for rlab mode.
If the variable `rlab-prefix-key' is nil, the bindings go directly
to `rlab-mode-map', otherwise they are prefixed with `rlab-prefix-key'."
(setq rlab-mode-map (make-sparse-keymap))
(define-key rlab-mode-map [menu-bar rlab-mode]
(cons "RLaB-Mode" rlab-mode-menu))
(let ((map (if rlab-prefix-key
(make-sparse-keymap)
rlab-mode-map)))
;; indentation
(define-key rlab-mode-map [?}] 'rlab-electric-brace)
;; communication
(define-key map "\M-e" 'rlab-send-current-line)
(define-key map "\M-r" 'rlab-send-region)
(define-key map "\M-w" 'rlab-send-proc)
(define-key map "\M-a" 'rlab-send-buffer)
(define-key map "\M-q" 'rlab-kill-process)
(define-key map "\M-u" 'rlab-restart-with-whole-file)
(define-key map "\M-s" 'rlab-show-process-buffer)
(define-key map "\M-h" 'rlab-hide-process-buffer)
(define-key map "\M-i" 'rlab-get-error-info)
(define-key map "\M-[" 'rlab-beginning-of-proc)
(define-key map "\M-]" 'rlab-end-of-proc)
(define-key map "\C-\M-s" 'rlab-set-rlab-region-start)
(define-key map "\C-\M-e" 'rlab-set-rlab-region-end)
(define-key map "\C-\M-r" 'rlab-send-rlab-region)
(if rlab-prefix-key
(define-key rlab-mode-map rlab-prefix-key map))
))
;;}}}
;;{{{ indentation
;;{{{ rlab-indent-line
(defun rlab-indent-line ()
"Indent current line as rlab code.
Return the amount the indentation changed by."
(let ((indent (rlab-calculate-indentation nil))
beg shift-amt
(case-fold-search nil)
(pos (- (point-max) (point))))
(beginning-of-line)
(setq beg (point))
(skip-chars-forward " \t")
(save-excursion
(while (eq (following-char) ?})
(setq indent (max (- indent rlab-indent-level) 0))
(forward-char 1)
(if (looking-at "\\([ \t]*\\)}")
(progn
(delete-region (match-beginning 1) (match-end 1))
(insert-char ? (1- rlab-indent-level))))))
(setq shift-amt (- indent (current-column)))
(if (zerop shift-amt)
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
(delete-region beg (point))
(indent-to indent)
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos))))
shift-amt))
;;}}}
;;{{{ rlab-calculate-indentation
(defun rlab-calculate-indentation (&optional parse-start)
"Return appropriate indentation for current line as rlab code.
In usual case returns an integer: the column to indent to."
(let ((pos (point)))
(save-excursion
(if parse-start
(setq pos (goto-char parse-start)))
(beginning-of-line)
(if (bobp)
(current-indentation)
(forward-char -1)
(if (eq (preceding-char) ?\\)
(+ (current-indentation)
(progn
(beginning-of-line)
(if (bobp)
(* 2 rlab-indent-level)
(forward-char -1)
(if (not (eq (preceding-char) ?\\))
(* 2 rlab-indent-level)
0))))
(forward-char 1)
(if (re-search-backward
"\\(^[^ \t\n\r]\\)\\|\\({\\s *\n\\)\\|\\(}\\s *\n\\)"
nil t)
(+ (- (current-indentation)
(if (save-excursion
(beginning-of-line)
(and (not (bobp))
(progn
(forward-char -1)
(eq (preceding-char) ?\\))))
(* 2 rlab-indent-level)
0))
(if (eq (following-char) ?{)
rlab-indent-level
0))
(goto-char pos)
(beginning-of-line)
(forward-line -1)
(current-indentation)))))))
;;}}}
;;{{{ rlab-electric-brace
(defun rlab-electric-brace (arg)
"Insert `}' and indent line for rlab."
(interactive "P")
(insert-char ?} (prefix-numeric-value arg))
(rlab-indent-line)
(blink-matching-open))
;;}}}
;;}}}
;;{{{ searching
;;{{{ rlab-beginning-of-proc
(defun rlab-beginning-of-proc (&optional arg)
"Move backward to the beginning of a rlab proc (or similar).
With argument, do it that many times. Negative arg -N
means move forward to Nth following beginning of proc.
Returns t unless search stops due to beginning or end of buffer."
(interactive "P")
(or arg
(setq arg 1))
(let ((found nil)
(ret t))
(if (and (< arg 0)
(looking-at "^[^ \t\n#][^\n]*{[ \t]*$"))
(forward-char 1))
(while (< arg 0)
(if (re-search-forward "^[^ \t\n#][^\n]*{[ \t]*$" nil t)
(setq arg (1+ arg)
found t)
(setq ret nil
arg 0)))
(if found
(beginning-of-line))
(while (> arg 0)
(if (re-search-backward "^[^ \t\n#][^\n]*{[ \t]*$" nil t)
(setq arg (1- arg))
(setq ret nil
arg 0)))
ret))
;;}}}
;;{{{ rlab-end-of-proc
(defun rlab-end-of-proc (&optional arg)
"Move forward to next end of rlab proc (or similar).
With argument, do it that many times. Negative argument -N means move
back to Nth preceding end of proc.
This function just searches for a `}' at the beginning of a line."
(interactive "P")
(or arg
(setq arg 1))
(let ((found nil)
(ret t))
(if (and (< arg 0)
(not (bolp))
(save-excursion
(beginning-of-line)
(eq (following-char) ?})))
(forward-char -1))
(while (> arg 0)
(if (re-search-forward "^}" nil t)
(setq arg (1- arg)
found t)
(setq ret nil
arg 0)))
(while (< arg 0)
(if (re-search-backward "^}" nil t)
(setq arg (1+ arg)
found t)
(setq ret nil
arg 0)))
(if found
(end-of-line))
ret))
;;}}}
;;}}}
;;{{{ communication with a inferior process via comint
;;{{{ rlab-start-process
(defun rlab-start-process (name program &optional startfile &rest switches)
"Start a rlab process named NAME, running PROGRAM."
(or switches
(setq switches rlab-default-command-switches))
(setq rlab-process-buffer (apply 'make-comint name program startfile switches))
(setq rlab-process (get-buffer-process rlab-process-buffer))
(save-excursion
(set-buffer rlab-process-buffer)
(setq comint-prompt-regexp "^[^% ]*%\\( %\\)* *"))
)
;;}}}
;;{{{ rlab-kill-process
(defun rlab-kill-process ()
"Kill rlab subprocess and its buffer."
(interactive)
(if rlab-process-buffer
(kill-buffer rlab-process-buffer)))
;;}}}
;;{{{ rlab-set-rlab-region-start
(defun rlab-set-rlab-region-start (&optional arg)
"Set start of region for use with `rlab-send-rlab-region'."
(interactive)
(set-marker rlab-region-start (or arg (point))))
;;}}}
;;{{{ rlab-set-rlab-region-end
(defun rlab-set-rlab-region-end (&optional arg)
"Set end of region for use with `rlab-send-rlab-region'."
(interactive)
(set-marker rlab-region-end (or arg (point))))
;;}}}
;;{{{ send line/region/buffer to rlab-process
;;{{{ rlab-send-current-line
(defun rlab-send-current-line ()
"Send current line to rlab subprocess, found in `rlab-process'.
If `rlab-process' is nil or dead, start a new process first."
(interactive)
(let ((start (save-excursion (beginning-of-line) (point)))
(end (save-excursion (end-of-line) (point))))
(or (and rlab-process
(eq (process-status rlab-process) 'run))
(rlab-start-process rlab-default-application rlab-default-application))
(comint-simple-send rlab-process (buffer-substring start end))
(forward-line 1)
(if rlab-always-show
(display-buffer rlab-process-buffer))))
;;}}}
;;{{{ rlab-send-region
(defun rlab-send-region (start end)
"Send region to rlab subprocess, wrapped in `eval { ... }'."
(interactive "r")
(or (and rlab-process
(comint-check-proc rlab-process-buffer))
(rlab-start-process rlab-default-application rlab-default-application))
(comint-simple-send rlab-process
(concat rlab-default-eval
" "(buffer-substring start end) " "))
(if rlab-always-show
(display-buffer rlab-process-buffer)))
;;}}}
;;{{{ rlab-send-rlab-region
(defun rlab-send-rlab-region ()
"Send preset rlab region to rlab subprocess, wrapped in `eval { ... }'."
(interactive)
(or (and rlab-region-start rlab-region-end)
(error "rlab-region not set"))
(or (and rlab-process
(comint-check-proc rlab-process-buffer))
(rlab-start-process rlab-default-application rlab-default-application))
(comint-simple-send rlab-process
(concat rlab-default-eval
" "
(buffer-substring rlab-region-start rlab-region-end)
" "))
(if rlab-always-show
(display-buffer rlab-process-buffer)))
;;}}}
;;{{{ rlab-send-proc
(defun rlab-send-proc ()
"Send proc around point to rlab subprocess, wrapped in `eval { ... }'."
(interactive)
(let (beg end)
(save-excursion
(rlab-beginning-of-proc)
(setq beg (point))
(rlab-end-of-proc)
(setq end (point)))
(or (and rlab-process
(comint-check-proc rlab-process-buffer))
(rlab-start-process rlab-default-application rlab-default-application))
(comint-simple-send rlab-process
(concat rlab-default-eval
" "
(buffer-substring beg end)
" "))
(if rlab-always-show
(display-buffer rlab-process-buffer))))
;;}}}
;;{{{ rlab-send-buffer
(defun rlab-send-buffer ()
"Send whole buffer to rlab subprocess, wrapped in `eval { ... }'."
(interactive)
(or (and rlab-process
(comint-check-proc rlab-process-buffer))
(rlab-start-process rlab-default-application rlab-default-application))
(if (buffer-modified-p)
(comint-simple-send rlab-process
(concat
rlab-default-eval
" "
(buffer-substring (point-min) (point-max))
" "))
(comint-simple-send rlab-process
(concat "load(\""
(buffer-file-name)
"\")")))
(if rlab-always-show
(display-buffer rlab-process-buffer)))
;;}}}
;;}}}
;;{{{ rlab-get-error-info
(defun rlab-get-error-info ()
"Send string `set errorInfo' to rlab subprocess and display the rlab buffer."
(interactive)
(or (and rlab-process
(comint-check-proc rlab-process-buffer))
(rlab-start-process rlab-default-application rlab-default-application))
(comint-simple-send rlab-process "set errorInfo\n")
(display-buffer rlab-process-buffer))
;;}}}
;;{{{ rlab-restart-with-whole-file
(defun rlab-restart-with-whole-file ()
"Restart rlab subprocess and send whole file as input."
(interactive)
(rlab-kill-process)
(rlab-start-process rlab-default-application rlab-default-application)
(rlab-send-buffer))
;;}}}
;;{{{ rlab-show-process-buffer
(defun rlab-show-process-buffer ()
"Make sure `rlab-process-buffer' is being displayed."
(interactive)
(display-buffer rlab-process-buffer))
;;}}}
;;{{{ rlab-hide-process-buffer
(defun rlab-hide-process-buffer ()
"Delete all windows that display `rlab-process-buffer'."
(interactive)
(delete-windows-on rlab-process-buffer))
;;}}}
;;}}}
;;{{{ menu bar
(define-key rlab-mode-menu [restart-with-whole-file]
'("Restart With Whole File" . rlab-restart-with-whole-file))
(define-key rlab-mode-menu [kill-process]
'("Kill Process" . rlab-kill-process))
(define-key rlab-mode-menu [hide-process-buffer]
'("Hide Process Buffer" . rlab-hide-process-buffer))
(define-key rlab-mode-menu [get-error-info]
'("Get Error Info" . rlab-get-error-info))
(define-key rlab-mode-menu [show-process-buffer]
'("Show Process Buffer" . rlab-show-process-buffer))
(define-key rlab-mode-menu [end-of-proc]
'("End Of Proc" . rlab-end-of-proc))
(define-key rlab-mode-menu [beginning-of-proc]
'("Beginning Of Proc" . rlab-beginning-of-proc))
(define-key rlab-mode-menu [send-rlab-region]
'("Send RLaB-Region" . rlab-send-rlab-region))
(define-key rlab-mode-menu [set-rlab-regio-end]
'("Set RLaB-Region End" . rlab-set-rlab-region-end))
(define-key rlab-mode-menu [set-rlab-region-start]
'("Set RLaB-Region Start" . rlab-set-rlab-region-start))
(define-key rlab-mode-menu [send-current-line]
'("Send Current Line" . rlab-send-current-line))
(define-key rlab-mode-menu [send-region]
'("Send Region" . rlab-send-region))
(define-key rlab-mode-menu [send-proc]
'("Send Proc" . rlab-send-proc))
(define-key rlab-mode-menu [send-buffer]
'("Send Buffer" . rlab-send-buffer))
;;}}}
;;{{{ Emacs local variables
;; Local Variables:
;; folded-file: t
;; End:
;;}}}
;;; rlab-mode.el ends here